{ fix tis unit }
unit hadeconnectionmanager;

{$I ..\hddefines.inc}
{$mode objfpc}{$H+}

interface

uses
  Classes,
  SysUtils,
  hademapbase,
  hadebaseconnection,
  hadebroker,
  contnrs,
  hadebaseobject;

type
  { THadeConnection }
  THadeConnection = class(THadeBaseObject)
  private
    IConnection: IHadeConnection;
    FConnectionName: string;
    FBroker: THdBroker;
    function getParams: TStrings;
    procedure setParams(AValue: TStrings);
  protected
    function getDatabase: string;
    function getHost: string;
    function getPassword: string;
    function getUsername: string;

    procedure setDatabase(AValue: string);
    procedure setHost(AValue: string);
    procedure setPassword(AValue: string);
    procedure setUsername(AValue: string);
  public
    constructor Create(const ABroker: THdBroker; const AConnectionName: string);

    procedure StartTransaction;
    procedure Commit;
    procedure Rollback;

    procedure Connect;
    procedure Diconnect;

    procedure ExecuteDirect(const ASql: string);
    function isConnected: boolean;
    function ConnectionName: string;

    function getLastInsertID(ATableName: string): int64;

    procedure setDataSet(const ADataSet: Pointer);

    property Params: TStrings read getParams write setParams;
    property Database: string read getDatabase write setDatabase;
    property Host: string read getHost write setHost;
    property Username: string read getUsername write setUsername;
    property Password: string read getPassword write setPassword;
    property Broker: THdBroker read FBroker;
  end;

  { TConnectionInfo }

  TConnectionInfo = class
  private
    FBroker: THdBroker;
    FDatabase: string;
    FDefault: boolean;
    FHost: string;
    FParams: TStrings;
    FPassword: string;
    FUsername: string;
  public
    property Params: TStrings read FParams write FParams;
    property Database: string read FDatabase write FDatabase;
    property Host: string read FHost write FHost;
    property Username: string read FUsername write FUsername;
    property Password: string read FPassword write FPassword;
    property IsDefault: boolean read FDefault write FDefault;
    property Broker: THdBroker read FBroker write FBroker;

    constructor create;
    destructor destroy;override;
  end;

  { THadeConnectionList }
  {* List of Connection *}
  THadeConnectionList = class
  protected
    FStack: TObjectStack;
  public
    function Extract: THadeConnection;
    function add(var AConnection: THadeConnection): THadeConnection;
    function StackCount: integer;

    constructor Create;
    destructor Destroy; override;
  end;

  { THadeMapInfoList }
  {* Map List of TConnectionInfo *}
  THadeMapInfoList = class(THadeMapBase)
  private
    fDefaultConnectionName : String;
    fdefaultConnection : TConnectionInfo;
  protected
    function getItem(index: integer): TConnectionInfo; reintroduce;
  public
    function getDefault():TConnectionInfo;
    function getDefaultConnectionName():String;
    property Items[index: integer]: TConnectionInfo read getItem;
    function find(const s: shortstring=''): TConnectionInfo; reintroduce;
  end;

  { THadeMapConnectionList }
  {* Map List of THadeConnectionList *}
  THadeMapConnectionList = class(THadeMapBase)
  protected
    function getItem(index: integer): THadeConnectionList; reintroduce;
  public
    property Items[index: integer]: THadeConnectionList read getItem;
    function find(const s: shortstring): THadeConnectionList; reintroduce;
  end;

  { THadeConnectionPool }
  { TODO 1 -oFajar -cOPF : implement maxSize and timeout }
  THadeConnectionPool = class(THadeBaseObject)
  private
    FMapConnection: THadeMapConnectionList;
    FMapInfo: THadeMapInfoList;
    FMaxSize: ptrUint;
    constructor Create;
  public
    function ConnectionByName(const AConnectionName: string = ''): THadeConnection;
    procedure ReturnConnection(var AConnection: THadeConnection);

    function getDefaultConnectionName:String;

    procedure RegisterConnection(
      const AConnectionName, ADatabase, AHost, AUser, APassword: string;
      const ABroker: THdBroker;
      const ADefault: boolean = False;
      const AParams:TStrings = nil);

    procedure RegisterConnection(const AConnectionName: string;
      const AConnectionInfo: TConnectionInfo);

    function NumConnectionByName(AConnectionName: string): integer;

    destructor Destroy; override;
  end;

function GHadeConnectionManager: THadeConnectionPool;

implementation

uses
  hadeexception,
  hadeconst,
  hadesqldbconnection{$IFDEF INDEBUG}, dbugintf{$ENDIF};

var
  FHadeConnectionPool: THadeConnectionPool = nil;

function GHadeConnectionManager: THadeConnectionPool;
begin
  { TODO 1 -oFajar -cOPF : make thread safe }
  if not Assigned(FHadeConnectionPool) then
    FHadeConnectionPool := THadeConnectionPool.Create;
  Result := FHadeConnectionPool;
end;

{ TConnectionInfo }

constructor TConnectionInfo.create;
begin
  fParams:=TStrings.Create;
end;

destructor TConnectionInfo.destroy;
begin
  if Assigned(fParams) then
    freeAndNil(fParams);
  inherited destroy;
end;

{ THadeMapConnectionList }

function THadeMapConnectionList.getItem(index: integer): THadeConnectionList;
begin
  Result := THadeConnectionList(inherited getItem(index));
end;

function THadeMapConnectionList.find(const s: shortstring): THadeConnectionList;
begin
  Result := THadeConnectionList(inherited find(s));
end;

{ THadeMapInfoList }

function THadeMapInfoList.getItem(index: integer): TConnectionInfo;
begin
  Result := TConnectionInfo(inherited getItem(index));
end;

function THadeMapInfoList.getDefault: TConnectionInfo;
var
  iloop: Integer;
  this: TConnectionInfo;
begin
  Result := nil;

  if Assigned(fDefaultConnection) then
  begin
    Result := fDefaultConnection;
    exit;
  end;

  for iloop := 0 to pred(count)do
  begin
    this := items[iloop];
    if this.IsDefault then
    begin
      fDefaultConnection := this;
      fDefaultConnectionName := self.NameOfIndex(iloop);
      Result := fDefaultConnection;
      break;
    end;
  end;

  if result = nil then
    Raise EHadeProgrammerException.create('no default connection exists.');
end;

function THadeMapInfoList.getDefaultConnectionName: String;
begin
  if trim(fDefaultConnectionName) = '' then
    getDefault();
  Result := fDefaultConnectionName;
end;

function THadeMapInfoList.find(const s: shortstring): TConnectionInfo;
begin
  if trim(s) = '' then
    Result := getDefault()
  else
    Result := TConnectionInfo(inherited find(s));
end;

{ THadeConnectionList }

function THadeConnectionList.Extract: THadeConnection;
begin
  Result := THadeConnection(FStack.Pop);
end;

function THadeConnectionList.add(var AConnection: THadeConnection): THadeConnection;
begin
  Result := THadeConnection(FStack.Push(AConnection));
end;

function THadeConnectionList.StackCount: integer;
begin
  Result := Fstack.Count;
end;

constructor THadeConnectionList.Create;
begin
  FStack := TObjectStack.Create;
end;

destructor THadeConnectionList.Destroy;
var
  iloop: integer;
begin
  { little housekepping }
  for iloop := 0 to pred(FStack.Count) do
    FStack.Pop.Free;
  FreeAndNil(FStack);
  inherited Destroy;
end;

{ THadeConnection }

function THadeConnection.getParams: TStrings;
begin
  Result := IConnection.Params;
end;

procedure THadeConnection.setParams(AValue: TStrings);
begin
  IConnection.Params := AValue;
end;

function THadeConnection.getDatabase: string;
begin
  Result := IConnection.Database;
end;

function THadeConnection.getHost: string;
begin
  Result := IConnection.Host;
end;

function THadeConnection.getPassword: string;
begin
  Result := IConnection.Password;
end;

function THadeConnection.getUsername: string;
begin
  Result := IConnection.Username;
end;

procedure THadeConnection.setDatabase(AValue: string);
begin
  IConnection.Database := AValue;
end;

procedure THadeConnection.setHost(AValue: string);
begin
  IConnection.Host := AValue;
end;

procedure THadeConnection.setPassword(AValue: string);
begin
  IConnection.Password := AValue;
end;

procedure THadeConnection.setUsername(AValue: string);
begin
  IConnection.Username := AValue;
end;

constructor THadeConnection.Create(const ABroker: THdBroker;
  const AConnectionName: string);
begin
  FConnectionName := AConnectionName;
  FBroker := ABroker;
  case FBroker of
    SQLdb_Firebird: IConnection := THadeIBConnection.Create;
    SQLdb_MySQL: IConnection := THadeMySQLConnection.Create;
    SQLdb_SQLite: IConnection := THadeSQLiteConnection.Create;
    SQLdb_Oracle: IConnection := THadeOracleConnection.Create;
    SQLdb_Postgre: IConnection := THadePostgreConnection.Create;
    SQLDB_ODBC: IConnection := THadeODBCConnection.Create;
    else
      raise  EHadeBrokerCurrentlyNotSupported.CreateFmt(
        CHadeBrokerCurrentlyNotSupported, [BrokerAsString(FBroker)]);
  end;
end;

procedure THadeConnection.StartTransaction;
begin
  IConnection.StartTransaction;
  {$IFDEF INDEBUG}
  dbugintf.SendDebug('Connection.StartTransaction');
  {$ENDIF}
end;

procedure THadeConnection.Commit;
begin
  IConnection.Commit;
  {$IFDEF INDEBUG}
  dbugintf.SendDebug('Connection.Commmt');
  {$ENDIF}
end;

procedure THadeConnection.Rollback;
begin
  IConnection.Rollback;
  {$IFDEF INDEBUG}
  dbugintf.SendDebug('Connection.Rollback');
  {$ENDIF}
end;

procedure THadeConnection.Connect;
begin
  IConnection.Connect;
end;

procedure THadeConnection.Diconnect;
begin
  IConnection.Disconnect;
end;

procedure THadeConnection.ExecuteDirect(const ASql: string);
begin
  IConnection.ExecuteDirect(ASql);
end;

function THadeConnection.isConnected: boolean;
begin
  Result := IConnection.isConnected;
end;

function THadeConnection.ConnectionName: string;
begin
  Result := FConnectionName;
end;

function THadeConnection.getLastInsertID(ATableName: string): int64;
begin
  Result:=0;
  if self.Broker = SQLDB_SQLite then
    Result := (IConnection as THadeSQLiteConnection).getLastInsertID(ATableName);
end;

procedure THadeConnection.setDataSet(const ADataSet: Pointer);
begin
  IConnection.setDataSet(ADataSet);
end;

{ THadeConnectionPool }

function THadeConnectionPool.ConnectionByName(
  const AConnectionName: string): THadeConnection;
{* we have two local function here
 * createWithConnectionMap() and  createConnection()
 * for details see implementation }

  function createWithConnectionMap: THadeConnection;
  var
    Info: TConnectionInfo;
    FList: THadeConnectionList;
    con: THadeConnection;
  begin
    Info := FMapInfo.Find(AConnectionName);

    if info = nil then
      raise EHadeMap.CreateFmt(CHadeMap, [AConnectionName]);

    con := THadeConnection.Create(Info.Broker, AConnectionName);
    con.Database := Info.Database;
    con.Host := Info.host;
    con.Username := Info.Username;
    con.Password := Info.Password;

    FList := THadeConnectionList.Create;
    FList.Add(Con);//<<add connection to List

    FMapConnection.add(AConnectionName, FList);//<<add list to ConnectionMap
    Result := FList.Extract;
  end;

  function createConnection: THadeConnection;
  var
    Info: TConnectionInfo;
    con: THadeConnection;
    conList: THadeConnectionList;
  begin
    Info := TConnectionInfo(FMapInfo.Find(AConnectionName));

    if info = nil then
      raise EHadeMap.CreateFmt(CHadeMap, [AConnectionName]);

    con := THadeConnection.Create(Info.Broker, AConnectionName);
    con.Database := Info.Database;
    con.Host := Info.host;
    con.Username := Info.Username;
    con.Password := Info.Password;

    conList := FMapConnection.Find(AConnectionName);
    conList.add(con);
    Result := conList.Extract;
  end;

var
  conList: THadeConnectionList;
begin
  if (FMapConnection.Find(AConnectionName) = nil) then
  begin
    //because FMapConnection don't have key = AConnectionName then we build one
    Result := createWithConnectionMap;
    Exit;
  end
  else
  begin
    conList := FMapConnection.find(AConnectionName);
    if conlist.StackCount > 0 then
      Result := conlist.Extract
    else
      Result := createConnection;
  end;
  {$IFDEF INDEBUG}
  dbugintf.SendDebug('obtaining connection : ' + IntToStr(
    NumConnectionByName(AConnectionName)));
  {$ENDIF}
end;

procedure THadeConnectionPool.ReturnConnection(var AConnection: THadeConnection);
var
  ConList: THadeConnectionList;
begin
  if FMapConnection.Find(AConnection.ConnectionName) = nil then
    raise EHadeMap.CreateFmt(CHadeMap, [AConnection.ConnectionName]);
  AConnection.Diconnect;
  ConList := FMapConnection.find(AConnection.ConnectionName);
  ConList.Add(AConnection);
  {$IFDEF INDEBUG}
  dbugintf.SendDebug('returning connection : ' + IntToStr(
    NumConnectionByName(AConnection.ConnectionName)));
  {$ENDIF}
end;

function THadeConnectionPool.getDefaultConnectionName: String;
begin
  Result := FMapInfo.getDefaultConnectionName();
end;

procedure THadeConnectionPool.RegisterConnection(
  const AConnectionName, ADatabase, AHost, AUser, APassword: string;
  const ABroker: THdBroker;const ADefault: boolean;const AParams: TStrings);
var
  FInfo: TConnectionInfo;
begin
  FInfo := TConnectionInfo.Create;
  FInfo.Database := ADatabase;
  FInfo.Host := AHost;
  FInfo.Username := AUser;
  FInfo.Password := APassword;
  FInfo.IsDefault := ADefault;
  if Assigned(AParams) then
    FInfo.Params := AParams;
  FInfo.Broker := ABroker;

  FMapInfo.add(AConnectionName, FInfo);
end;

procedure THadeConnectionPool.RegisterConnection(const AConnectionName: string;
  const AConnectionInfo: TConnectionInfo);
begin
  RegisterConnection(AConnectionName, AConnectionInfo.Database,
    AConnectionInfo.Host,
    AConnectionInfo.Username,
    AConnectionInfo.Password,
    AConnectionInfo.Broker,
    AConnectionInfo.IsDefault,
    AConnectionInfo.Params);
end;

function THadeConnectionPool.NumConnectionByName(AConnectionName: string): integer;
var
  conlist: THadeConnectionList;
begin
  conlist := FMapConnection.Find(AConnectionName);
  if Assigned(conlist) then
    Result := conlist.StackCount
  else
    Result := 0;
end;

constructor THadeConnectionPool.Create;
begin
  FMapConnection := THadeMapConnectionList.Create(True);
  FMapInfo := THadeMapInfoList.Create(True);
  FMaxSize := 100;
end;

destructor THadeConnectionPool.Destroy;
begin
  FreeAndNil(FMapConnection);
  FreeAndNil(FMapInfo);
  inherited Destroy;
end;

initialization
  GHadeConnectionManager();
finalization
  FreeAndNil(FHadeConnectionPool);

end.

